home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1988 / 09 / king.lis < prev    next >
File List  |  1988-08-22  |  11KB  |  460 lines

  1. _ADA FOR PASCAL PROGRAMMERS_
  2. by
  3. Kim King
  4.  
  5.  
  6. Example 1:  A Pascal program that counts occurrences of letters 
  7. in the input stream 
  8.  
  9. program CountLetters(input, output); 
  10.   { counts occurrences of letters in the input stream } 
  11.   var Counts: array ['a'..'z'] of integer; 
  12.       Ch: char; 
  13. begin 
  14.   for Ch := 'a' to 'z' do 
  15.     Counts[Ch] := 0; 
  16.   while not eof do 
  17.     begin 
  18.       read(Ch); 
  19.       if ('a' <= Ch) and (Ch <= 'z') then 
  20.         Counts[Ch] := Counts[Ch] + 1 
  21.       else if ('A' <= Ch) and (Ch <= 'Z') then 
  22.         begin 
  23.           Ch := chr(ord(Ch) - ord('A') + ord('a')); 
  24.           Counts[Ch] := Counts[Ch] + 1 
  25.         end 
  26.     end; 
  27.   for Ch := 'a' to 'z' do 
  28.     writeln(Ch, Counts[Ch]:6) 
  29. end. 
  30.  
  31.  
  32. Example 2:  An Ada program that counts occurrences of letters in 
  33. the input stream 
  34.  
  35.  
  36.  1. with Text_IO; use Text_IO; 
  37.  2. procedure Count_Letters is 
  38.  3.   -- counts occurrences of letters in the input stream 
  39.  4.   package Int_IO is new Integer_IO(Integer); 
  40.  5.   use Int_IO; 
  41.  6.   Counts: array ('a'..'z') of Integer := (others => 0); 
  42.  7.   Ch: Character; 
  43.  8. begin 
  44.  9.   while not End_Of_File loop 
  45. 10.     Get(Ch); 
  46. 11.     if 'a' <= Ch and Ch <= 'z' then 
  47. 12.       Counts(Ch) := Counts(Ch) + 1; 
  48. 13.     elsif 'A' <= Ch and Ch <= 'Z' then 
  49. 14.       Ch := Character'Val(Character'Pos(Ch) -
  50. 15.                           Character'Pos('A') + 
  51. 16.                           Character'Pos('a')); 
  52. 17.       Counts(Ch) := Counts(Ch) + 1; 
  53. 18.     end if; 
  54. 19.   end loop; 
  55. 20.   for Ch in 'a'..'z' loop 
  56. 21.     Put(Ch); 
  57. 22.     Put(Counts(Ch), 6); 
  58. 23.     New_Line; 
  59. 24.   end loop; 
  60. 25. end Count_Letters; 
  61.  
  62.  
  63.  
  64. Example 3: Overloading the Put procedure
  65.  
  66. procedure Put(File: File_Type; Item: Character); 
  67. procedure Put(Item: Character); 
  68. procedure Put(File: File_Type; Item: String); 
  69. procedure Put(Item: String); 
  70.  
  71.  
  72. Example 4: The specification of the Length_Conversions package 
  73.  
  74. package Length_Conversions is 
  75.   Feet_To_Meters: constant := 0.3048; 
  76.   Inches_To_Centimeters: constant := 2.54; 
  77.   Miles_To_Kilometers: constant := 1.6093; 
  78.   Yards_To_Meters: constant := 0.9144; 
  79. end Length_Conversions; 
  80.  
  81.  
  82. Example 5: A program that uses the Length_Conversions package 
  83.  
  84. with Text_IO, Length_Conversions; 
  85. use Text_IO, Length_Conversions; 
  86. procedure Convert_To_Meters is 
  87.   package Int_IO is new Integer_IO(Integer); 
  88.   use Int_IO; 
  89.   Feet: Integer; 
  90. begin 
  91.   Put("Enter a measurement in feet: "); 
  92.   Get(Feet); 
  93.   Skip_Line; 
  94.   Put("The equivalent measurement in meters is: "); 
  95.   Put(Integer(Float(Feet)*Feet_To_Meters), 1); 
  96.   New_Line; 
  97. end Convert_To_Meters; 
  98.  
  99.  
  100. Example 6: The specification of the Angle_Conversions package 
  101.  
  102. package Angle_Conversions is 
  103.   function Degrees_To_Radians(Degrees: Float) return Float; 
  104.   function Radians_To_Degrees(Radians: Float) return Float; 
  105. end Angle_Conversions; 
  106.  
  107.  
  108.  
  109. Example 7: The body of the Angle_Conversions package 
  110.  
  111. package body Angle_Conversions is 
  112.  
  113.   Two_Pi: constant := 2.0 * 3.14159; 
  114.  
  115.   function Degrees_To_Radians(Degrees: Float) return Float is 
  116.   begin 
  117.     return Two_Pi * Degrees / 360.0; 
  118.   end Degrees_To_Radians; 
  119.  
  120.   function Radians_To_Degrees(Radians: Float) return Float is 
  121.   begin 
  122.     return 360.0 * Radians / Two_Pi; 
  123.   end Radians_To_Degrees; 
  124.  
  125. end Angle_Conversions; 
  126.  
  127.  
  128. Example 8: The specification of the Char_Stack package 
  129.  
  130. package Char_Stack is 
  131.  
  132.   procedure Push(X: Character); 
  133.     -- pushes X onto the stack 
  134.  
  135.   procedure Pop(X: out Character); 
  136.     -- stores the top stack element into X, then pops the stack 
  137.  
  138.   function Is_Empty return Boolean; 
  139.     -- returns True if the stack is empty, False otherwise 
  140.  
  141. end Char_Stack; 
  142.  
  143.  
  144.  
  145. Example 9: The body of the Char_Stack package 
  146.  
  147. package body Char_Stack is 
  148.  
  149.   Stack_Size: constant := 100;  --maximum size of stack 
  150.   Stack_Array: array (1..Stack_Size) of Character; 
  151.   Top_Of_Stack: Integer range 0..Stack_Size := 0; 
  152.  
  153.   procedure Push(X: Character) is 
  154.   begin 
  155.     Top_Of_Stack := Top_Of_Stack + 1; 
  156.     Stack_Array(Top_Of_Stack) := X; 
  157.   end Push; 
  158.  
  159.   procedure Pop(X: out Character) is 
  160.   begin 
  161.     X := Stack_Array(Top_Of_Stack); 
  162.     Top_Of_Stack := Top_Of_Stack - 1; 
  163.   end Pop; 
  164.  
  165.   function Is_Empty return Boolean is 
  166.   begin 
  167.     return Top_Of_Stack = 0; 
  168.   end Is_Empty; 
  169.  
  170. end Char_Stack; 
  171.  
  172.  
  173. Example 10: A program that uses the Char_Stack package to reverse 
  174. a string 
  175.  
  176. with Text_IO, Char_Stack; 
  177. use Text_IO, Char_Stack; 
  178. procedure Reverse_String is 
  179.   Ch: Character; 
  180. begin 
  181.   Put("Enter string to be reversed: "); 
  182.   while not End_Of_Line loop 
  183.     Get(Ch); 
  184.     Push(Ch); 
  185.   end loop; 
  186.   Skip_Line; 
  187.  
  188.   Put("The reversal is: "); 
  189.   while not Is_Empty loop 
  190.     Pop(Ch); 
  191.     Put(Ch); 
  192.   end loop; 
  193.   New_Line; 
  194. end Reverse_String; 
  195.  
  196.  
  197. Example 11: The specification of the Char_Stacks package; 
  198. Char_Stack is an ordinary type
  199.  
  200. package Char_Stacks is 
  201.  
  202.   Stack_Size: constant := 100; 
  203.   type Array_Type is array (1..Stack_Size) of Character; 
  204.   type Char_Stack is 
  205.     record 
  206.       Stack_Array: Array_Type; 
  207.       Top_Of_Stack: Integer range 0..Stack_Size := 0; 
  208.     end record; 
  209.  
  210.   procedure Push(S: in out Char_Stack; X: Character); 
  211.     -- pushes X onto stack S 
  212.  
  213.   procedure Pop(S: in out Char_Stack; X: out Character); 
  214.     -- stores the top element of S into X, then pops S 
  215.  
  216.   function Is_Empty(S: Char_Stack) return Boolean; 
  217.     -- returns True if S is empty, False otherwise 
  218.  
  219. end Char_Stacks; 
  220.  
  221.  
  222. Example 12: The specification of the Char_Stacks package; 
  223. Char_Stack is a private type
  224.  
  225.  
  226. package Char_Stacks is 
  227.  
  228.   type Char_Stack is private; 
  229.  
  230.   procedure Push(S: in out Char_Stack; X: Character); 
  231.     -- pushes X onto stack S 
  232.  
  233.   procedure Pop(S: in out Char_Stack; X: out Character); 
  234.     -- stores the top element of S into X, then pops S 
  235.  
  236.   function Is_Empty(S: Char_Stack) return Boolean; 
  237.     -- returns True if S is empty, False otherwise 
  238.  
  239. private 
  240.   Stack_Size: constant := 100; 
  241.   type Array_Type is array (1..Stack_Size) of Character; 
  242.   type Char_Stack is 
  243.     record 
  244.       Stack_Array: Array_Type; 
  245.       Top_Of_Stack: Integer range 0..Stack_Size := 0; 
  246.     end record; 
  247. end Char_Stacks; 
  248.  
  249.  
  250. Example 13: The body of the Char_Stacks package 
  251.  
  252. package body Char_Stacks is 
  253.  
  254.   procedure Push(S: in out Char_Stack; X: Character) is 
  255.   begin 
  256.     S.Top_Of_Stack := S.Top_Of_Stack + 1; 
  257.     S.Stack_Array(S.Top_Of_Stack) := X; 
  258.   end Push; 
  259.  
  260.   procedure Pop(S: in out Char_Stack; X: out Character) is 
  261.   begin 
  262.     X := S.Stack_Array(S.Top_Of_Stack); 
  263.     S.Top_Of_Stack := S.Top_Of_Stack - 1; 
  264.   end Pop; 
  265.  
  266.   function Is_Empty(S: Char_Stack) return Boolean is 
  267.   begin 
  268.     return S.Top_Of_Stack = 0; 
  269.   end Is_Empty; 
  270.  
  271. end Char_Stacks; 
  272.  
  273.  
  274. Example 14: A program that uses the Char_Stacks package to 
  275. reverse a string 
  276.  
  277. with Text_IO, Char_Stacks; 
  278. use Text_IO, Char_Stacks; 
  279. procedure Reverse_String is 
  280.   S: Char_Stack; 
  281.   Ch: Character; 
  282. begin 
  283.   Put("Enter string to be reversed: "); 
  284.   while not End_Of_Line loop 
  285.     Get(Ch); 
  286.     Push(S, Ch); 
  287.   end loop; 
  288.   Skip_Line; 
  289.  
  290.   Put("The reversal is: "); 
  291.   while not Is_Empty(S) loop 
  292.     Pop(S, Ch); 
  293.     Put(Ch); 
  294.   end loop; 
  295.   New_Line; 
  296. end Reverse_String; 
  297.  
  298.  
  299.  
  300. Example 15: The specification of the Char_Stacks package with 
  301. exceptions added 
  302.  
  303. package Char_Stacks is 
  304.  
  305.   type Char_Stack is private; 
  306.  
  307.   procedure Push(S: in out Char_Stack; X: Character); 
  308.     -- pushes X onto stack S; raises Overflow if S is full 
  309.  
  310.   procedure Pop(S: in out Char_Stack; X: out Character); 
  311.     -- stores the top element of S into X, then pops S 
  312.     -- raises Underflow if S is empty 
  313.  
  314.   function Is_Empty(S: Char_Stack) return Boolean; 
  315.     -- returns True if S is empty, False otherwise 
  316.  
  317.   Overflow, Underflow: exception; 
  318.  
  319. private 
  320.   Stack_Size: constant := 100; 
  321.   type Array_Type is array (1..Stack_Size) of Character; 
  322.   type Char_Stack is 
  323.     record 
  324.       Stack_Array: Array_Type; 
  325.       Top_Of_Stack: Integer range 0..Stack_Size := 0; 
  326.     end record; 
  327. end Char_Stacks; 
  328.  
  329.  
  330.  
  331.  
  332. Example 16: The body of the Char_Stacks package with exceptions 
  333. added 
  334.  
  335. package body Char_Stacks is 
  336.  
  337.   procedure Push(S: in out Char_Stack; X: Character) is 
  338.   begin 
  339.     if S.Top_Of_Stack = Stack_Size then 
  340.       raise Overflow; 
  341.     end if; 
  342.     S.Top_Of_Stack := S.Top_Of_Stack + 1; 
  343.     S.Stack_Array(S.Top_Of_Stack) := X; 
  344.   end Push; 
  345.  
  346.   procedure Pop(S: in out Char_Stack; X: out Character) is 
  347.   begin 
  348.     if S.Top_Of_Stack = 0 then 
  349.       raise Underflow; 
  350.     end if; 
  351.     X := S.Stack_Array(S.Top_Of_Stack); 
  352.     S.Top_Of_Stack := S.Top_Of_Stack - 1; 
  353.   end Pop; 
  354.  
  355.   function Is_Empty(S: Char_Stack) return Boolean is 
  356.   begin 
  357.     return S.Top_Of_Stack = 0; 
  358.   end Is_Empty; 
  359.  
  360. end Char_Stacks; 
  361.  
  362.  
  363. Example 17: A program that uses the Char_Stacks package to 
  364. reverse a string (with exception handling added) 
  365.  
  366.  
  367. with Text_IO, Char_Stacks; 
  368. use Text_IO, Char_Stacks; 
  369. procedure Reverse_String is 
  370.   S: Char_Stack; 
  371.   Ch: Character; 
  372. begin 
  373.   Put("Enter string to be reversed: "); 
  374.   begin 
  375.     while not End_Of_Line loop 
  376.       Get(Ch); 
  377.       Push(S, Ch); 
  378.     end loop; 
  379.   exception 
  380.     when Overflow => null;   -- ignore overflow 
  381.   end; 
  382.   Skip_Line; 
  383.  
  384.   Put("The reversal is: "); 
  385.   while not Is_Empty(S) loop 
  386.     Pop(S, Ch); 
  387.     Put(Ch); 
  388.   end loop; 
  389.   New_Line; 
  390. end Reverse_String; 
  391.  
  392.  
  393. Example 18: The specification of the generic Stacks package 
  394.  
  395. generic 
  396.   type Element is private; 
  397. package Stacks is 
  398.  
  399.   type Stack is private; 
  400.  
  401.   procedure Push(S: in out Stack; X: Element); 
  402.     -- pushes X onto stack S; raises Overflow if S is full 
  403.  
  404.   procedure Pop(S: in out Stack; X: out Element); 
  405.     -- stores the top element of S into X, then pops S 
  406.     -- raises Underflow if S is empty 
  407.  
  408.   function Is_Empty(S: Stack) return Boolean; 
  409.     -- returns True if S is empty, False otherwise 
  410.  
  411.   Overflow, Underflow: exception; 
  412.  
  413. private 
  414.   Stack_Size: constant := 100; 
  415.   type Array_Type is array (1..Stack_Size) of Element; 
  416.   type Stack is 
  417.     record 
  418.       Stack_Array: Array_Type; 
  419.       Top_Of_Stack: Integer range 0..Stack_Size := 0; 
  420.     end record; 
  421. end Stacks; 
  422.  
  423.  
  424. Example 19: A program that uses the generic Stacks package to 
  425. reverse a string 
  426.  
  427. with Text_IO, Stacks; 
  428. use Text_IO; 
  429. procedure Reverse_String is 
  430.  
  431.   package Char_Stacks is new Stacks(Character); 
  432.   use Char_Stacks; 
  433.  
  434.   S: Stack; 
  435.   Ch: Character; 
  436.  
  437. begin 
  438.   Put("Enter string to be reversed: "); 
  439.   begin 
  440.     while not End_Of_Line loop 
  441.       Get(Ch); 
  442.       Push(S, Ch); 
  443.     end loop; 
  444.   exception 
  445.     when Overflow => null; 
  446.   end; 
  447.   Skip_Line; 
  448.  
  449.   Put("The reversal is: "); 
  450.   while not Is_Empty(S) loop 
  451.     Pop(S, Ch); 
  452.     Put(Ch); 
  453.   end loop; 
  454.   New_Line; 
  455. end Reverse_String; 
  456.  
  457.  
  458.  
  459.  
  460.